home *** CD-ROM | disk | FTP | other *** search
/ Softdisk G-S 97 / SGDS 97.2mg / SDGS.97 / SDC97 / C / DIN.PRG (.txt) < prev    next >
Encoding:
Applesoft BASIC Source Code  |  1989-09-20  |  10.5 KB  |  379 lines  |  [FC] Applesoft BASIC Program (0x0801)
  1. 10  HIMEM: 30208
  2. 20  PRINT  CHR$(20)
  3. 30  INVERSE : SPEED= 255
  4. 40  REM <CTRL-0x0a>WINDOWRTNS $800-$0DFF
  5. 50 :
  6. 60  PRINT  CHR$(4)"BLOAD DIN.SHPS.LNK,a$8600"
  7. 70  PRINT  CHR$(4)"BLOAD DIN.BLKINV.PNP"
  8. 75  PRINT  CHR$(4)"BLOAD DIN.DUMP"
  9. 80  PRINT  CHR$(4)"BLOAD DIN.TITLE.LNK,A$1100": TEXT 
  10. 82  HGR : POKE 49234,0
  11. 90  POKE 0,0: POKE 1,17: POKE 2,0: POKE 3,0: POKE 4,0: POKE 5,1: CALL 37379
  12. 100  PRINT  CHR$(4)"-DIN.WBX"
  13. 110  POKE 48688, PEEK(0): POKE 48689, PEEK(1): POKE 49168,0
  14. 120  VTAB 23: HTAB 16: PRINT "Press a key": ON  PEEK(49152) <128 GOTO 120: GET K$
  15. 130  POKE 216,0: REM  rebegin after err
  16. 140  POKE 0,0: POKE 1,134: POKE 2,0: POKE 3,0: POKE 4,0: POKE 5,16: CALL 37379
  17. 142  ONERR  GOTO 149
  18. 143 PF$ = ""
  19. 144  PRINT  CHR$(4)"VERIFY/RAM/DIN.FI.LNK"
  20. 145 PF$ = "/RAM/"
  21. 149  CALL 54915: POKE 216,0: REM  CLEAR STACK & ERR HANDLER
  22. 150  ONERR  GOTO 62900
  23. 160  REM LOAD FNT $0E00
  24. 170 :
  25. 190  DIM H1(1),B1(1),T1(1),R1(1),F1(1),H(1,1),B(1,1),T(1,1),R(1,1),F(1,1),TB(5),HE(1),BA(1),TA(1),RE(1),FO(1): REM  which body part is active, where to plot body parts, tabs for jar lids, number of different bodyparts
  26. 200  DIM N$(39),NA$(1),SF$(8)
  27. 210  REM <CTRL-0x0a>PLOT X,Y FOR PARTS<CTRL-0x0a>
  28. 215 : REM       SHORT               TALL
  29. 220 H(0,0) = 25:H(0,1) = 09:H(1,0) = 18:H(1,1) = 00
  30. 230 B(0,0) = 12:B(0,1) = 02:B(1,0) = 15:B(1,1) = 34
  31. 240 T(0,0) = 01:T(0,1) = 47:T(1,0) = 03:T(1,1) = 36
  32. 250 R(0,0) = 12:R(0,1) = 57:R(1,0) = 15:R(1,1) = 54
  33. 260 F(0,0) = 19:F(0,1) = 58:F(1,0) = 22:F(1,1) = 45
  34. 265 :
  35. 270 HE(0) = 8:HE(1) = 7:BA(0) = 8:BA(1) = 4:TA(0) = 8:TA(1) = 3:RE(0) = 8:RE(1) = 4:FO(0) = 8:FO(1) = 3: REM   NUMBER OF PARTS PER DINO
  36. 272 TI$ = "S.LNK":TY =  INT( RND(1) *2): IF TY  THEN TI$ = "I.LNK"
  37. 280 H1(0) =  INT( RND(1) *HE(0)) +1:H1(1) =  INT( RND(1) *HE(1)) +1:B1(0) =  INT( RND(1) *BA(0)) +1:B1(1) =  INT( RND(1) *BA(1)) +1
  38. 285 T1(0) =  INT( RND(1) *TA(0)) +1:T1(1) =  INT( RND(1) *TA(1)) +1:F1(0) =  INT( RND(1) *FO(0)) +1:F1(1) =  INT( RND(1) *FO(1)) +1
  39. 287 R1(0) =  INT( RND(1) *RE(0)) +1:R1(1) =  INT( RND(1) *RE(1)) +1: REM  INIT ALL BODY PARTS
  40. 290  GOSUB 27000: REM read dino names
  41. 300 BOX = 2051:OBOX = 2054:CBOX = 2057:PNP = 37379:SPKR = 49200:DUMP = 36352
  42. 310  GOSUB 34000
  43. 320  GOSUB 11000
  44. 325  GOSUB 26000: REM  GET NAME
  45. 330  VTAB 17: GOSUB 28000: REM name it
  46. 340  REM <CTRL-0x0a><CTRL-0x0a>DATASTOR $1100<CTRL-0x0a><CTRL-0x0a>
  47. 350  REM to chg data,2060 lobyte 2061 hibyte
  48. 360  SPEED= 255
  49. 370  VTAB 24: HTAB 2: PRINT "  Press ? for info, oh Dino-Sorcerer"
  50. 380  GOSUB 34000
  51. 390 RAN = 0
  52. 400  IF RAN = 0  THEN  GOSUB 58000
  53. 410  IF RAN  THEN K$ =  CHR$( RND(1) *26 +65)
  54. 430  IF K$ = "?"  OR K$ = "/"  THEN SV$ = "": GOSUB 32000: GOTO 370
  55. 440  IF K$ = "Q"  OR K$ =  CHR$(27)  THEN SV$ = "": GOSUB 53000: ON   NOT EX GOTO 370: GOTO 50000
  56. 450  IF K$ = "C"  THEN SV$ = "": GOTO 540
  57. 451  IF K$ = "S"  THEN SV$ = "": GOSUB 31000: GOTO 370
  58. 452  IF K$ = "P"  THEN SV$ = "": GOSUB 30000: GOTO 370
  59. 455  IF K$ < >"H"  THEN  IF K$ < >"B"  THEN  IF K$ < >"T"  THEN  IF K$ < >"F"  THEN  IF K$ < >"R"  THEN 515
  60. 460  IF PF$ < >"/RAM/"  THEN  CALL OBOX,12,22,14,3: PRINT " Working..."
  61. 470  IF K$ = "H"  THEN  GOSUB 21000: GOTO 520
  62. 480  IF K$ = "B"  THEN  GOSUB 22000: GOTO 520
  63. 490  IF K$ = "T"  THEN  GOSUB 23000: GOTO 520
  64. 500  IF K$ = "F"  THEN  GOSUB 24000: GOTO 520
  65. 510  IF K$ = "R"  THEN  GOSUB 25000: GOTO 520
  66. 515 P = 222:D = 9: GOSUB 60000: GOTO 370
  67. 520  VTAB 17: GOSUB 26000: GOSUB 28000: REM  PRINT NAME
  68. 530  GOTO 370
  69. 540  IF TI$ = "S.LNK"  THEN TY = 1:TI$ = "I.LNK": GOTO 560
  70. 550  IF TI$ = "I.LNK"  THEN TY = 0:TI$ = "S.LNK"
  71. 560  POKE 0,0: POKE 1,134: POKE 2,0: POKE 3,0: POKE 4,0: POKE 5,16: CALL 37379
  72. 570 :
  73. 580  GOTO 300
  74. 9999  END 
  75. 10000  REM <CTRL-0x0a>PNP<CTRL-0x0a>
  76. 10010  POKE 0,AL: POKE 1,AH
  77. 10020  POKE 2,LI
  78. 10030  POKE 3,CO
  79. 10040  POKE 4,FT
  80. 10050  POKE 5,SH
  81. 10060  CALL PNP
  82. 10070  RETURN 
  83. 10999  REM <CTRL-0x0a>RANDOM DINO<CTRL-0x0a>
  84. 11000 AH = 126:FT = 3: CALL OBOX,12,22,14,3: PRINT " Working..."
  85. 11005  PRINT  CHR$(4)"BLOAD"PF$"DIN.H"TI$",a$7E00":SH = H1(TY):CO = H(TY,0):LI = H(TY,1): GOSUB 10000
  86. 11010  PRINT  CHR$(4)"BLOAD"PF$"DIN.B"TI$",a$7E00":SH = B1(TY):CO = B(TY,0):LI = B(TY,1): GOSUB 10000
  87. 11020  PRINT  CHR$(4)"BLOAD"PF$"DIN.T"TI$",a$7E00":SH = T1(TY):CO = T(TY,0):LI = T(TY,1): GOSUB 10000
  88. 11030  PRINT  CHR$(4)"BLOAD"PF$"DIN.F"TI$",a$7E00":SH = F1(TY):CO = F(TY,0):LI = F(TY,1): GOSUB 10000
  89. 11040  PRINT  CHR$(4)"BLOAD"PF$"DIN.R"TI$",a$7E00":SH = R1(TY):CO = R(TY,0):LI = R(TY,1): GOSUB 10000
  90. 11050  CALL CBOX: RETURN 
  91. 12000  REM <CTRL-0x0a>BOTTLE OPENER<CTRL-0x0a>
  92. 12002  GOSUB 29000: REM  CLEAR NAME
  93. 12005 T = TP
  94. 12010 TB(1) = 1:TB(2) = 8:TB(3) = 15:TB(4) = 22:TB(5) = 29
  95. 12020  FOR X = 1 TO 15
  96. 12030  POKE 0,0: POKE 1,134: POKE 2,122: POKE 3,TB(T): POKE 4,0: POKE 5,X: CALL PNP
  97. 12033  IF X = 12  THEN  FOR P = 71 TO 4  STEP  -20:D = 2: GOSUB 60010: NEXT 
  98. 12040  NEXT 
  99. 12050  RETURN 
  100. 20000  REM <CTRL-0x0a>help<CTRL-0x0a>
  101. 20010  CALL OBOX,4,5,34,13: HCOLOR= 0
  102. 20020  PRINT " Dino-Sorcerer Help Screen:"
  103. 20025  PRINT 
  104. 20030  PRINT " Press H for a new head"
  105. 20040  PRINT " Press B for a new back"
  106. 20050  PRINT " Press F for new forelegs"
  107. 20060  PRINT " Press R for new rear legs"
  108. 20070  PRINT " Press T for a new tail"
  109. 20080  PRINT " Press C to change dino types"
  110. 20090  PRINT " Press S to save the dinosaur"
  111. 20092  PRINT " Press P to print the dinosaur"
  112. 20100  PRINT " Press Q or ESC to quit"
  113. 20110  PRINT  CHR$(20): VTAB 24: HTAB 1: PRINT  SPC( 55)"Press a key."
  114. 20220  GET K$
  115. 20230  GOSUB 34000
  116. 20240  RETURN 
  117. 21000  REM <CTRL-0x0a>head<CTRL-0x0a>
  118. 21010 FT = 3:MX = HE(TY)
  119. 21015 TP = 1
  120. 21016 CO = H(TY,0):LI = H(TY,1)
  121. 21020  IF SV$ < >K$ +TI$  THEN  PRINT  CHR$(4)"BLOAD"PF$"DIN.H"TI$",a$7E00":SV$ = K$ +TI$
  122. 21021  CALL CBOX
  123. 21025 SH = H1(TY)
  124. 21030  GOSUB 12000: GOSUB 10000
  125. 21040 FT = 3
  126. 21050 H1(TY) = H1(TY) +1
  127. 21060  IF H1(TY) >MX  THEN H1(TY) = 1
  128. 21065 SH = H1(TY)
  129. 21070  GOSUB 10000
  130. 21080  RETURN 
  131. 22000  REM <CTRL-0x0a>BACK<CTRL-0x0a>
  132. 22010 FT = 3:MX = BA(TY)
  133. 22015 TP = 4
  134. 22016 CO = B(TY,0):LI = B(TY,1)
  135. 22020  IF SV$ < >K$ +TI$  THEN  PRINT  CHR$(4)"BLOAD"PF$"DIN.B"TI$",a$7E00":SV$ = K$ +TI$
  136. 22021  CALL CBOX
  137. 22025 SH = B1(TY)
  138. 22030  GOSUB 12000: GOSUB 10000
  139. 22040 FT = 3
  140. 22050 B1(TY) = B1(TY) +1
  141. 22060  IF B1(TY) >MX  THEN B1(TY) = 1
  142. 22065 SH = B1(TY)
  143. 22070  GOSUB 10000
  144. 22080  RETURN 
  145. 23000  REM <CTRL-0x0a>TAIL<CTRL-0x0a>
  146. 23010 FT = 3:MX = TA(TY)
  147. 23015 TP = 5
  148. 23016 CO = T(TY,0):LI = T(TY,1)
  149. 23020  IF SV$ < >K$ +TI$  THEN  PRINT  CHR$(4)"BLOAD"PF$"DIN.T"TI$",a$7E00":SV$ = K$ +TI$
  150. 23021  CALL CBOX
  151. 23025 SH = T1(TY)
  152. 23030  GOSUB 12000: GOSUB 10000
  153. 23040 FT = 3
  154. 23050 T1(TY) = T1(TY) +1
  155. 23060  IF T1(TY) >MX  THEN T1(TY) = 1
  156. 23065 SH = T1(TY)
  157. 23070  GOSUB 10000
  158. 23080  RETURN 
  159. 24000  REM <CTRL-0x0a>FORE<CTRL-0x0a>
  160. 24010 FT = 3:MX = FO(TY)
  161. 24015 TP = 2
  162. 24016 CO = F(TY,0):LI = F(TY,1)
  163. 24020  IF SV$ < >K$ +TI$  THEN  PRINT  CHR$(4)"BLOAD"PF$"DIN.F"TI$",a$7E00":SV$ = K$ +TI$
  164. 24021  CALL CBOX
  165. 24025 SH = F1(TY)
  166. 24030  GOSUB 12000: GOSUB 10000
  167. 24040 FT = 3
  168. 24050 F1(TY) = F1(TY) +1
  169. 24060  IF F1(TY) >MX  THEN F1(TY) = 1
  170. 24065 SH = F1(TY)
  171. 24070  GOSUB 10000
  172. 24080  RETURN 
  173. 25000  REM <CTRL-0x0a>REAR<CTRL-0x0a>
  174. 25010 FT = 3:MX = RE(TY)
  175. 25015 TP = 3
  176. 25016 CO = R(TY,0):LI = R(TY,1)
  177. 25020  IF SV$ < >K$ +TI$  THEN  PRINT  CHR$(4)"BLOAD"PF$"DIN.R"TI$",a$7E00":SV$ = K$ +TI$
  178. 25021  CALL CBOX
  179. 25025 SH = R1(TY)
  180. 25030  GOSUB 12000: GOSUB 10000
  181. 25040 FT = 3
  182. 25050 R1(TY) = R1(TY) +1
  183. 25060  IF R1(TY) >MX  THEN R1(TY) = 1
  184. 25065 SH = R1(TY)
  185. 25070  GOSUB 10000
  186. 25080  RETURN 
  187. 26000  REM <CTRL-0x0a>dino name<CTRL-0x0a>
  188. 26010 NA = H1(TY) *BA(TY) *TA(TY) *RE(TY) *FO(TY)
  189. 26020 NA = NA +B1(TY) *TA(TY) *RE(TY) *FO(TY)
  190. 26030 NA = NA +T1(TY) *RE(TY) *FO(TY)
  191. 26040 NA = NA +R1(TY) *FO(TY)
  192. 26050 NA = NA +F1(TY)
  193. 26060 NA = NA +TY *35841
  194. 26070 NS = NA
  195. 26080 N1 =  INT(NA/1600)
  196. 26090 NA = NA -(N1 *1600)
  197. 26100 N2 =  INT(NA/40)
  198. 26110 N3 = NA -(N2 *40)
  199. 26120 NA$(TY) = N$(N1) +N$(N2) +N$(N3) +SF$(H1(TY))
  200. 26130  IF NS = 8539  AND TY = 0  THEN NA$(TY) = "boreostracon": GOSUB 55000
  201. 26140  IF NS = 10660  AND TY = 0  THEN NA$(TY) = "triceratops": GOSUB 55000
  202. 26145  IF NS = 17810  AND TY = 0  THEN NA$(TY) = "apatosaurus": GOSUB 55000
  203. 26150  IF NS = 21513  AND TY = 0  THEN NA$(TY) = "stegosaurus": GOSUB 55000
  204. 26160  IF NS = 27044  AND TY = 0  THEN NA$(TY) = "monoclonius": GOSUB 55000
  205. 26170  IF NS = 36086  AND TY = 1  THEN NA$(TY) = "trachodon": GOSUB 55000
  206. 26180  IF NS = 36290  AND TY = 1  THEN NA$(TY) = "corythosaurus": GOSUB 55000
  207. 26185  IF NS = 36434  AND TY = 1  THEN NA$(TY) = "parasaurolophus": GOSUB 55000
  208. 26190  IF NS = 36835  AND TY = 1  THEN NA$(TY) = "tyrannosaurus": GOSUB 55000
  209. 26200  IF NS = 37037  AND TY = 1  THEN NA$(TY) = "struthiomimus": GOSUB 55000
  210. 26210  IF NS = 36519  AND TY = 1  THEN NA$(TY) = "iguanodon": GOSUB 55000
  211. 26220  RETURN 
  212. 27000  REM <CTRL-0x0a>get names<CTRL-0x0a>
  213. 27010  RESTORE 
  214. 27020  FOR X1 = 0 TO 39
  215. 27030  READ N$(X1)
  216. 27040  NEXT 
  217. 27042  FOR X1 = 1 TO 8: READ SF$(X1): NEXT 
  218. 27050  RETURN 
  219. 27060  DATA vara,podoke,salto,compso,plateo,stego,bronto,cyno,meso,pachy,paleo
  220. 27070  DATA maxi,titano,gravi,lystro,forti,campto,camara,gorgo,brachio,plateo
  221. 27080  DATA yaleo,diplo,tyranno,scelido,pola,boreo,para,lambeo,cerato,toro
  222. 27090  DATA pachy,mono,styraco,proto,megalo,kento,pola,scolo,cephalo
  223. 27095  DATA nops,saurus,gnathus,saurus,don,saurus,raptor,saurus
  224. 27999  REM  center na$
  225. 28000  REM <CTRL-0x0a>PRINT NAME<CTRL-0x0a>
  226. 28010  HCOLOR= 0: VTAB 17: HTAB (20 - LEN(NA$(TY))/2): PRINT  CHR$( ASC(NA$(TY)) -32) MID$ (NA$(TY),2): RETURN 
  227. 29000  HCOLOR= 0: VTAB 17: HTAB 1: PRINT  SPC( 39): HTAB 1: RETURN 
  228. 30000  REM <CTRL-0x0a>DINO DUMP<CTRL-0x0a>
  229. 30010  CALL OBOX,1,18,40,7: HCOLOR= 0
  230. 30020  PRINT  CHR$(12);: HOME : PRINT " Dino-Sorcerer will work only with"
  231. 30030  PRINT " Apple ImageWriter printers. Do you"
  232. 30040  PRINT " have one hooked up and online?"
  233. 30050  PRINT "             (Y/N/ESC)"
  234. 30060  GOSUB 58000: IF K$ = "N"  OR K$ =  CHR$(27)  THEN 30170
  235. 30070  IF K$ < >"Y"  THEN P = 222:D = 31: GOSUB 60000: GOTO 30020
  236. 30080  ONERR  GOTO 30190
  237. 30090 PR = 1: PRINT  CHR$(12): HOME : PRINT : PRINT "       Attempting to access the": PRINT "          printer in slot "PR".": PRINT "         Press ESC to cancel."
  238. 30100  PRINT  CHR$(4)"PR#"PR
  239. 30110  PRINT 
  240. 30120  ONERR  GOTO 62900
  241. 30130  POKE DUMP +3,255: POKE DUMP +4,PR: PRINT  CHR$(9)"80n": CALL DUMP: REM  normal mode, slot (one), echo off
  242. 30140  PRINT  CHR$(12);: HOME 
  243. 30150  PRINT  CHR$(4)"PR#0"
  244. 30160  CALL 2048: POKE 48688, PEEK(0): POKE 48689, PEEK(1)
  245. 30170  CALL CBOX
  246. 30180  RETURN 
  247. 30190  CALL  -3288: POKE 216,0: PRINT  CHR$(4)"pr#0": NORMAL : TEXT : HOME : VTAB 11: PRINT "NO DEVICE CONNECTED."
  248. 30200  ONERR  GOTO 30220
  249. 30210  PRINT "PRESS A KEY.": GET K$: HGR : POKE 49234,0: PRINT  CHR$(4)"-DIN.WBX": POKE 48688, PEEK(0): POKE 48689, PEEK(1): RUN 130
  250. 30220  POKE 216,0: PRINT  CHR$(4)"pr#0": TEXT : HOME : VTAB 12: PRINT "FATAL ERROR. PRESS A KEY.": GET K$: GOTO 50000
  251. 31000  REM <CTRL-0x0a>SAVE PICTURE TO DISK<CTRL-0x0a>
  252. 31010  CALL OBOX,1,18,40,7: HCOLOR= 0
  253. 31020  PRINT "Save picture as:"
  254. 31030 IW = 64:V = 20:H = 1
  255. 31040  GOSUB 59000
  256. 31050  PRINT  CHR$(12);: HOME 
  257. 31060  IF IN$ = ""  THEN 31200
  258. 31070  GOSUB 33000: REM  spaces out
  259. 31080  PRINT : PRINT : PRINT : PRINT "Saving it..."
  260. 31090  HCOLOR= 3
  261. 31100  FOR X1 = 137 TO 191
  262. 31110  HPLOT 0,X1 TO 279,X1
  263. 31120  NEXT 
  264. 31130  ONERR  GOTO 31150
  265. 31140  PRINT  CHR$(4)"bsave"IN$",a$2000,l$2000": GOTO 31200
  266. 31150  CALL  -3288: POKE 216,0: PRINT  CHR$(12);: HOME : PRINT " Unable to save the file."
  267. 31160  IF  PEEK(222) = 16  THEN  PRINT " Bad file name."
  268. 31170  IF  PEEK(222) = 8  THEN  PRINT " I/O error."
  269. 31171  IF  PEEK(222) = 9  THEN  PRINT " Disk full."
  270. 31172  IF  PEEK(222) = 17  THEN  PRINT " Directory full."
  271. 31173  IF  PEEK(222) = 10  THEN  PRINT " File locked."
  272. 31174  IF  PEEK(222) = 13  THEN  PRINT " Wrong file type."
  273. 31180  IF  PEEK(222) = 6  OR  PEEK(222) = 7  THEN  PRINT " Path not found."
  274. 31190  IF  PEEK(222) = 4  THEN  PRINT " Disk is write-protected."
  275. 31191  PRINT " Press a key.": GET K$: ONERR  GOTO 62900
  276. 31200  CALL CBOX: ONERR  GOTO 62900
  277. 31210  RETURN 
  278. 32000  REM <CTRL-0x0a>info menu<CTRL-0x0a>
  279. 32010  CALL OBOX,5,6,32,3: HCOLOR= 0
  280. 32020  PRINT " Press ? for instructions";
  281. 32030  CALL OBOX,5,9,32,3: HCOLOR= 0
  282. 32040  PRINT " Press C for the credits";
  283. 32050  CALL OBOX,5,12,32,3: HCOLOR= 0
  284. 32060  PRINT " Any other key to exit";
  285. 32070  GOSUB 58000
  286. 32075  IF K$ = "C"  THEN  GOSUB 34000: GOSUB 63000
  287. 32080  IF K$ = "?"  OR K$ = "/"  THEN  GOSUB 34000: GOSUB 20000
  288. 32100  GOSUB 34000
  289. 32110  RETURN 
  290. 33000  REM <CTRL-0x0a>space.to.period<CTRL-0x0a>
  291. 33010  ON IN$ = "" GOTO 33020:T1$ = "": FOR T = 1 TO  LEN(IN$):T$ =  MID$ (IN$,T,1):T$ =  MID$ ( MID$ (IN$,T,1) +".",(T$ = " ") +1,1):T1$ = T1$ +T$: NEXT :IN$ = T1$
  292. 33020  RETURN 
  293. 34000  FOR X1 = 1 TO 8: CALL CBOX: NEXT : RETURN 
  294. 50000  REM <CTRL-0x0a>Quit<CTRL-0x0a>
  295. 50010  IF PF$ < >"/RAM/"  THEN 50090
  296. 50020 T1$ =  CHR$(4) +"DELETE/RAM/DIN.":T2$ = ".LNK"
  297. 50030  PRINT T1$"HS"T2$: PRINT T1$"HI"T2$: PRINT T1$"TS"T2$: PRINT T1$"TI"T2$: PRINT T1$"BS"T2$: PRINT T1$"BI"T2$: PRINT T1$"RS"T2$: PRINT T1$"RI"T2$: PRINT T1$"FS"T2$: PRINT T1$"FI"T2$
  298. 50090  PRINT  CHR$(4)"BYE"
  299. 53000  REM <CTRL-0x0a>exit vfy<CTRL-0x0a>
  300. 53010  CALL OBOX,12,12,16,7: HCOLOR= 0
  301. 53020  PRINT : PRINT " Do you really";: PRINT " want to quit?";: PRINT "  (Y/N/ESC)"
  302. 53025  PRINT  CHR$(20): VTAB 24: HTAB 1: PRINT  SPC( 50)"Press Y or N or ESC""
  303. 53030  GOSUB 58000
  304. 53040  IF K$ < >"Y"  AND K$ < >"N"  AND K$ < > CHR$(27)  THEN  CALL BOX,12,12,16,7:P = 222:D = 31: GOSUB 60000: GOTO 53020
  305. 53050 EX = 1: IF K$ = "Y"  THEN 53070
  306. 53060 EX = 0
  307. 53070  GOSUB 34000: RETURN 
  308. 55000  REM <CTRL-0x0a>win<CTRL-0x0a>
  309. 55010 D = 5
  310. 55015 P$ = "213191171161144128114108108"
  311. 55018  FOR ZY = 1 TO 3: FOR ZZ = 1 TO  LEN(P$)  STEP 3:P =  VAL( MID$ (P$,ZZ,3)): GOSUB 60000: NEXT : NEXT 
  312. 55020  GOSUB 56000: REM  educate module
  313. 55030  RETURN 
  314. 56000  REM <CTRL-0x0a>educate<CTRL-0x0a>
  315. 56010  CALL OBOX,1,18,40,7: HCOLOR= 0
  316. 56020  PRINT  CHR$(12);: HOME : PRINT " "; CHR$( ASC(NA$(TY)) -32) MID$ (NA$(TY),2)":": PRINT 
  317. 56030  PRINT " Do you want more information about"
  318. 56040  PRINT " this actual animal? (Y/N/ESC)"
  319. 56050  GOSUB 58000
  320. 56060  IF K$ = "N"  OR K$ =  CHR$(27)  THEN 56080
  321. 56062  IF K$ < >"Y"  THEN P = 222:D = 31: GOSUB 60000: GOTO 56020
  322. 56070  GOSUB 57000
  323. 56080  RETURN 
  324. 57000  REM <CTRL-0x0a>more info<CTRL-0x0a>
  325. 57010  PRINT  CHR$(12);: HOME : PRINT " ";
  326. 57020 FI$ = "din.dat." + LEFT$(NA$(TY),5)
  327. 57030  PRINT  CHR$(4)"open"FI$
  328. 57040  PRINT  CHR$(4)"read"FI$
  329. 57043 LN = 1:EX = 0
  330. 57050  GET K$
  331. 57052  IF K$ = "^"  THEN LN = 4:EX = 1: GOTO 57060
  332. 57055  IF K$ =  CHR$(13)  THEN LN = LN +1: PRINT K$" ";: GOTO 57060
  333. 57056  PRINT K$;: GOTO 57050
  334. 57060  IF LN = 4  THEN  PRINT : PRINT "             Press a key.": POKE 49168,0: WAIT 49152,128: POKE 49168,0: PRINT  CHR$(12);: HOME : PRINT " ";: ON (( PEEK(49152) = 27)  OR (EX)) GOTO 57080: GOTO 57043
  335. 57065  GOTO 57050
  336. 57080  PRINT  CHR$(4)"close"
  337. 57090  RETURN 
  338. 58000  REM <CTRL-0x0a>get key<CTRL-0x0a>
  339. 58010  GET K$: IF K$ >"Z"  THEN K$ =  CHR$( ASC(K$) -32)
  340. 58020  RETURN 
  341. 59000  REM <CTRL-0x0a>INPUT IN$<CTRL-0x0a>
  342. 59005 IN$ =  LEFT$(NA$(TY),11) +".pic"
  343. 59010 BS$ =  CHR$(8):ES$ =  CHR$(27):CR$ =  CHR$(13): VTAB V: HTAB H: PRINT IN$;
  344. 59020  PRINT "_ "BS$BS$;
  345. 59030  GET K$
  346. 59040  IF K$ =  CHR$(127)  THEN K$ = BS$
  347. 59050  IF K$ = ES$  THEN IN$ = "": GOTO 59120
  348. 59060  IF K$ = BS$  THEN  IF  LEN(IN$) = 1  THEN IN$ = "": PRINT BS$;: GOTO 59020
  349. 59070  IF K$ = BS$  THEN  IF  LEN(IN$)  THEN IN$ =  LEFT$(IN$, LEN(IN$) -1): PRINT  CHR$(8);: GOTO 59020
  350. 59080  IF K$ = CR$  THEN  PRINT : GOTO 59120
  351. 59090  IF K$ > = " "  THEN  IF  LEN(IN$) <IW  THEN IN$ = IN$ +K$: PRINT K$;: GOTO 59110
  352. 59100  PRINT  CHR$(7);
  353. 59110  GOTO 59020
  354. 59120  RETURN 
  355. 60000  CALL  PEEK(121) + PEEK(122) *256 +32,P,D: REM   GET  COS g EXP R CHR$ ONERR P PLOT  TAN GET   GET  COS g EXP R CHR$ ONERR P PLOT  ATN GET  PLOT 0 TAB(  GR  MID$  MID$  = <CTRL-0x05>  OR  ATN GET <UNKNOWN TOKEN><CTRL-0x13> * = <CTRL-0x05> RESTORE  TAN GET  = <UNKNOWN TOKEN> RIGHT$<CTRL-0x01> =  MID$  IF  TAN GET  =  PEEK````
  356. 60010  RETURN : REM hummy
  357. 61000  CALL  PEEK(121) + PEEK(122) *256 +28: REM 8 <CTRL-0x1f><UNKNOWN TOKEN> GOSUB <CTRL-0x02> HGR2 <CTRL-0x01>` IF ^ TAB(  IF ) TAB( <CTRL-0x09>  PLOT ) TAB( `
  358. 61010  RETURN : REM mono
  359. 62000  CALL  PEEK(121) + PEEK(122) *256 +28: REM 8 <CTRL-0x1f><UNKNOWN TOKEN> GOSUB <CTRL-0x02> HGR2 <CTRL-0x01>` IF _ TAB(  IF ) TAB( ) SIN PLOT ) TAB( `
  360. 62010  RETURN : REM color
  361. 62096  PRINT  CHR$(20) CHR$(12): HOME 
  362. 62900  REM  error
  363. 62901  POKE 216,0: CALL 54915: ONERR  GOTO 62900
  364. 62902  PRINT  CHR$(4)"CLOSE"
  365. 62905  CALL 2054,5,10,30,3: PRINT "Fatal error. Press a key.": GET K$: FOR X1 = 1 TO 8: CALL 2057: NEXT 
  366. 62910  RUN 130
  367. 63000  REM (c)
  368. 65535  CALL OBOX,4,5,34,11
  369. 65535  PRINT 
  370. 65535  PRINT "          Dino-Sorcerer"
  371. 65535  PRINT "          by Jim Weiler"
  372. 65535  PRINT "  Copyright 1989 Softdisk, Inc."
  373. 65535  PRINT "       All rights reserved"
  374. 65535  PRINT "    Published on Softdisk #97"
  375. 65535  PRINT "  Subscriptions: 1-800-831-2694"
  376. 65535  PRINT " Changing this notice is illegal"
  377. 65535  PRINT  CHR$(20): VTAB 24: HTAB 1: PRINT  SPC( 55)"Press a key."
  378. 65535  POKE 49168,0: WAIT 49152,128: POKE 49168,0
  379. 65535  RETURN